home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / freetype.zip / ttzoom.pas < prev   
Pascal/Delphi Source File  |  1996-08-30  |  6KB  |  343 lines
  1. program TrueType_Show;
  2.  
  3. uses Crt, TTDisp, TTTypes, TTCalc, TTTables, Raster;
  4.  
  5. { $DEFINE DEBUG}
  6. {$DEFINE VISUAL}
  7.  
  8.  
  9. (* Ce petit programme a la prétention d'afficher les glyphes qui constituent
  10.    les caractères des fontes TrueType *)
  11.  
  12. const
  13.   Precis  = 64;
  14.   Precis2 = Precis div 2;
  15.  
  16.   PrecisAux = 1024;
  17.  
  18.   Centre_X : int = 320;
  19.   Centre_Y : int = 225;
  20.  
  21.   Profile_Buff_Size = 64000;
  22.  
  23. var
  24.  
  25.   Font_Buffer : PStorage;
  26.  
  27.   curGlyphContours : PGlyphContours;
  28.  
  29.   num_pts : word;
  30.   num_ctr : word;
  31.  
  32.   glyfArray : word;
  33.  
  34.   epts_ctr : PShortArray;
  35.  
  36.   xCoord : PStorage;
  37.   yCoord : PStorage;
  38.   Flag   : PByteArray;
  39.  
  40.   ymin, ymax, xmax, xmin, xsize : longint;
  41.   res,  resB                    : int;
  42.  
  43.   resR : real;
  44.  
  45.   resX, resY : real;
  46.  
  47.   LastX, LastY : FixedPoint;
  48.  
  49.   numPoints, numContours : int;
  50.  
  51.   curGlyph        : ^TGlyph;
  52.   curGlyphContour : PGlyphContour;
  53.  
  54.   Bit : TRasterBlock;
  55.  
  56.   yCur : integer;
  57.  
  58.   ScXMax, ScYMax,
  59.   CntX, CntY : Integer;
  60.  
  61.   Rotation : int;  (* Angle modulo 1024 *)
  62.  
  63.  
  64. Procedure InitRows;
  65. var
  66.   i: integer;
  67.   P: Pointer;
  68. begin
  69.  
  70.   Bit.rows  := 450;
  71.   Bit.cols  := 80;
  72.   Bit.width := 640;
  73.   Bit.flow  := TTFlowUp;
  74.   Bit.size  := 80*450;
  75.  
  76.   GetMem( Bit.buffer, Bit.size );
  77.   if Bit.buffer = NIL then
  78.    begin
  79.     Writeln('ERREUR:InitRows:Pas assez de mémoire pour le BitMap');
  80.     halt(1);
  81.    end;
  82.  
  83.   GetMem( P, Profile_Buff_Size );
  84.   if P=nil then
  85.    begin
  86.     writeln('ERREUR:InitRows:Pas assez de mémoire pour le buffer profils');
  87.     Halt(2);
  88.    end;
  89.  
  90.   InitRasterizer( Bit, P, Profile_Buff_Size );
  91.  
  92.   FillChar( Bit.Buffer^, Bit.Size, 0 );
  93. end;
  94.  
  95.  
  96. Procedure ClearData;
  97. var i: integer;
  98. begin
  99.   FillChar( Bit.Buffer^, Bit.Size, 0 );
  100.  
  101.   FreeMem( XCoord, SizeOf(FixedPoint)*numPoints );
  102.   FreeMem( YCoord, SizeOf(FixedPoint)*numPoints );
  103.  
  104.   FreeMem( Flag, numPoints );
  105. end;
  106.  
  107.  
  108. Function LoadTrueTypeChar( idx : integer ) : boolean;
  109. var
  110.   off    : longint;
  111.   x, y   : Real;
  112.   i, szp : integer;
  113.   j      : word;
  114.   c, ct  : byte;
  115.   Gl     : TGlyph;
  116.   EM     : Word;
  117.   CR, SR : Real;
  118.  
  119. begin
  120.   LoadtrueTypeChar:=FALSE;
  121.   if (idx<0) or (idx>=Num_Glyphs) then exit;
  122.  
  123.   CurGlyph := @Glyphs^[idx];
  124.   Gl       := CurGlyph^;
  125.  
  126.   numPoints        := Gl.numberOfPoints;
  127.   numContours      := Gl.numberOfContours;
  128.   curGlyphContours := Gl.Contours;
  129.  
  130.   GetMem( XCoord, SizeOf(Fixed)*numPoints );
  131.   GetMem( YCoord, SizeOf(Fixed)*numPoints );
  132.   GetMem( Flag, numPoints );
  133.  
  134.   xMin := Gl.xMin;
  135.   xMax := Gl.xMax;
  136.   yMin := Gl.yMin;
  137.   yMax := Gl.yMax;
  138.  
  139.   EM := Font_Header^.UnitsPerEM;
  140.  
  141.   dec( xMax, xMin );
  142.   dec( yMax, yMin );
  143.  
  144.   dec ( res );
  145.   resR := res/EM/2;
  146.  
  147.   xmax := trunc( xmax * resR + 0.5 );
  148.   ymax := trunc( ymax * resR + 0.5 );
  149.  
  150.   CR := Cos( Rotation*Pi/512 );
  151.   SR := Sin( Rotation*Pi/512 );
  152.  
  153.   for j:=0 to numPoints-1 do
  154.    begin
  155.  
  156.     x := Gl.Points^[j].x * ( res / EM );
  157.     y := Gl.Points^[j].y * ( res / EM );
  158.  
  159.     off := Trunc( Precis*( CR*(x-xmax) + SR*(y-ymax) ) );
  160.  
  161.     XCoord^[j] := Precis*Centre_X + off;
  162.     XCoord^[j] := Precis*( Centre_X + off div Precis ) + Precis2;
  163.  
  164.     off := Trunc( Precis*( - SR*(x-xmax) + CR*(y-ymax) ) );
  165.  
  166.     YCoord^[j] := Precis*Centre_Y + off;
  167.     YCoord^[j] := Precis*( Centre_Y + off div Precis ) + Precis2;
  168.  
  169.     Flag^[j] := Gl.Points^[j].flag and 1;
  170.    end;
  171.  
  172.   inc ( res );
  173.   resR := 1/res;
  174.  
  175.   xsize := ( xmax + 7 ) div 8;
  176.  
  177.   LoadTrueTypeChar:=TRUE;
  178. end;
  179.  
  180.  
  181. function ConvertRaster : boolean;
  182. var
  183.   B : Array[0..128] of Integer;
  184.   i : integer;
  185.   G : TGlyphRecord;
  186. begin
  187.  
  188.   for i := 0 to numContours-1 do
  189.     B[i] := CurGlyphContours^[i].Finish;
  190.  
  191.   G.Outlines  := numContours;
  192.   G.OutStarts := @B;
  193.   G.Points    := numPoints;
  194.   G.XCoord    := XCoord;
  195.   G.YCoord    := YCoord;
  196.   G.Flag      := Flag;
  197.  
  198.   ConvertRaster := RenderGlyph ( G, res, res );
  199. end;
  200.  
  201.  
  202.  
  203.  
  204. var i: integer;
  205.     heure,
  206.     min1,
  207.     min2,
  208.     sec1,
  209.     sec2,
  210.     cent1,
  211.     cent2  :
  212. {$IFDEF OS2}
  213.     longint;
  214. {$ELSE}
  215.     word;
  216. {$ENDIF}
  217.  
  218.     C : Char;
  219.  
  220.     Filename : String;
  221.  
  222. label Fin;
  223.  
  224. var
  225.   Fail : Int;
  226.  
  227.  
  228. begin
  229.   TextMode( co80+Font8x8 );
  230.  
  231.   GetMem    ( Font_Buffer, 64000 );
  232.   InitBuffer( Font_Buffer^, 64000 );
  233.  
  234.   curGlyphContours:=NIL;
  235.  
  236.   num_pts   :=0;
  237.   num_ctr   :=0;
  238.  
  239.   xCoord  :=NIL;
  240.   yCoord  :=NIL;
  241.   Flag    :=NIL;
  242.  
  243.   for i:=0 to ParamCount do Writeln(ParamStr(i));
  244.  
  245.   If paramCount<>1 then
  246.    begin
  247.     Writeln('Usage : ',paramStr(0),' FontName[.TTF]');
  248.     Halt(1);
  249.    end;
  250.  
  251.   Filename := ParamStr(1);
  252.   if Pos('.',FileName)=0 then FileName:=FileName+'.TTF';
  253.   if not Open_TrueType_File(Filename ) then
  254.    begin
  255.     Writeln('Erreur, le fichier ',ParamStr(1),' n''a pu être ouvert');
  256.     Halt(1);
  257.    end;
  258.  
  259.   res  := 450;
  260.   resB := (res+7) div 8;
  261.  
  262.   Rotation := 0;
  263.  
  264.   Fail := 0;
  265.  
  266.   Load_TrueType_Tables;
  267.  
  268.   Load_TrueType_MaxProfile;
  269.  
  270.   if Load_TrueType_Glyphs=0 then
  271.    begin
  272.     Writeln('Problème lors du chargement des glyphes');
  273.     Halt(1);
  274.    end;
  275.  
  276.   InitRows;
  277.  
  278.   SetGraphScreen;
  279.  
  280.   I   := 1;
  281.   res := 640;
  282.  
  283.   Repeat
  284.  
  285.     if LoadtrueTypeChar(i) then
  286.  
  287.       if ConvertRaster then
  288.  
  289.         Display( Bit.Buffer^, 450, 80 )
  290.  
  291.       else
  292.         inc( Fail );
  293.  
  294.     C:=Readkey;
  295.     Case C of
  296.  
  297.      #27 : goto Fin;
  298.  
  299.      #0 : begin
  300.            C:=Readkey;
  301.            Case C of
  302.  
  303.             #115 : if i>10 then dec(i,10) else i:=0;
  304.  
  305.             #116 : if i < Num_Glyphs-11 then inc(i,10)
  306.                     else i:=Num_Glyphs-1;
  307.  
  308.  
  309.  
  310.             #75 : if i>0 then dec(i);
  311.             #77 : if i< Num_Glyphs-1 then inc(i);
  312.             #72 : if res > 0 then dec(res);
  313.             #80 : if res < 450 then inc(res);
  314.            end;
  315.           end;
  316.  
  317.      '<' : Rotation := ( Rotation - 1 ) and 1023;
  318.  
  319.      '>' : Rotation := ( Rotation + 1 ) and 1023;
  320.  
  321.      ';' : Rotation := ( Rotation - 16 ) and 1023;
  322.      ':' : Rotation := ( Rotation + 16 ) and 1023;
  323.  
  324.      '+' : if res < 1040 then inc(res,10) else
  325.             res := 1050;
  326.  
  327.      '-' : if res > 11 then dec(res,10) else
  328.             res := 1;
  329.  
  330.     end;
  331.  
  332.     ClearData;
  333.  
  334.   Until false;
  335.  
  336.  Fin:
  337.   RestoreScreen;
  338.   Close_TrueType_File;
  339.  
  340.   Writeln('Echecs : ', Fail );
  341. end.
  342.  
  343.